home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Mops 2.5 / Mops ƒ / PathsMod.txt < prev    next >
Encoding:
Text File  |  1994-05-07  |  1.9 KB  |  75 lines  |  [TEXT/MSET]
  1. \ We call this module if a list of HFS path designators is to be used to
  2. \ find a file.  First we grab the file with the list
  3. \ of path designators (one per line).  For each designator we prepend
  4. \ it to the given filename, and attempt to open the file.  We keep
  5. \ going until either the open succeeds or we run out of path designators.
  6. \ If the open succeeds we leave the name in the fcb set to the full
  7. \ path name.  If the open fails we restore the name to what it was.
  8.  
  9. objPtr        PATHS_F    class_is  file
  10. objHandle    PATHS_HDL
  11.  
  12. string        NAME
  13. string        FULLNAME
  14. string        PDS
  15.  
  16. local    OWP  { fcb mode \ ret? -- rc }
  17.  
  18. : OPENLOOP
  19.     BEGIN              \ Loop over path designators
  20.         len: pds
  21.         NIF                                        \ Not found
  22.             all: name  fcb name: file            \ Restore orig name
  23.             FNF  EXIT
  24.         THEN
  25.         RET  chsearch: pds  -> ret?
  26.         pds ->: fullName  name  $add: fullName
  27.         all: fullName  fcb name: file
  28.         fcb mode (open)  NIF  0  EXIT  THEN        \ Found
  29.         step: pds  ret? negate skip: pds
  30.     AGAIN  ;
  31.  
  32.  
  33. :loc OWP
  34.     reset: pds
  35.     len: pds  NIF  FNF  EXIT  THEN
  36.             \ If no paths, we return a "file not found" error.
  37. \    fcb  getName: file
  38.     getName: fcb
  39.     put: name  new: fullName
  40.     openLoop
  41.     release: name  release: fullName  ;loc
  42.  
  43.  
  44. : GETPATHS    \ ( addr len -- )
  45.     true -> use_paths?        \ This becomes the default now
  46.                     \  that GETPATHS has been called
  47.     keep: pathsMod
  48.     nil?: pds  IF  new: pds  ELSE  clear: pds  THEN
  49.     release: paths_hdl  ['] file  newObj: paths_hdl
  50.     obj: paths_hdl  -> paths_f
  51.     name: paths_f  openReadOnly: paths_f
  52.     IF
  53.         msg# 133        \ Warning - couldn't find paths file
  54.         release: paths_hdl  nilP -> paths_f  EXIT
  55.     THEN
  56.     size: paths_f  setsize: pds
  57.     all: pds  read: paths_f  drop
  58.     close: paths_f  drop  releaseObj: paths_hdl  ;
  59.  
  60.  
  61. : .PATHS  { \ ret? -- }
  62.     nil?: pds  ?EXIT
  63.     reset: pds
  64.     BEGIN
  65.         len: pds  0EXIT
  66.         RET  chsearch: pds  -> ret?
  67.         get: pds  type  cr
  68.         step: pds  ret? negate skip: pds
  69.     AGAIN  ;
  70.  
  71.  
  72. : REL    release: pds  ;
  73.  
  74. ' rel  setRelease
  75.